home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fcube.F < prev    next >
Text File  |  1991-06-03  |  3KB  |  167 lines
  1.  
  2. c
  3. c a program to demonstrate  double buffering and what happens
  4. c when you hit a clipping plane. Specifying an extra argument
  5. c turns on the filling.
  6. c
  7.     program cube
  8.  
  9. #ifdef SGI
  10. #include "fgl.h"
  11. #include "fdevice.h"
  12. #else
  13. #include "fvogl.h"
  14. #include "fvodevice.h"
  15. #endif
  16.  
  17.     character ans*1
  18.     real    t, dt
  19.     integer nplane, r, dr
  20.     logical ifill, s
  21.  
  22.     print*,'Fill the polygons (Y/N)?'
  23.     read(*, '(a)') ans
  24.     ifill = ans .eq. 'y' .or. ans .eq. 'Y'
  25.                   
  26.     call polymo(PYM_LI)
  27.     if (ifill) call polymo(PYM_FI)
  28.  
  29.     call prefsi(300, 300)
  30.  
  31.     call winope('fcube', 5)
  32.  
  33.     call unqdev(INPUTC)
  34.     call qdevic(KEYBD)
  35.  
  36.     dr = 100
  37.     dt = 0.2
  38.  
  39.     nplane = getpla()
  40.  
  41.     call color(BLACK)
  42.     call clear
  43.  
  44.     call window(-1.5, 1.5, -1.5, 1.5, 9.0, -5.0)
  45.     call lookat(0.0, 0.0, 12.0, 0.0, 0.0, 0.0, 0)
  46.  
  47.     call backfa(.true.)
  48. c
  49. c Setup drawing into the backbuffer....
  50. c
  51.     call double
  52.     call gconfi
  53.  
  54.     t = 0.0
  55.  
  56.     r = 0
  57.  
  58.  10    continue
  59.         if (r .ge. 3600) r = 0
  60.         call color(BLACK)
  61.         call clear
  62.  
  63.         call pushma
  64.  
  65.         call transl(0.0, 0.0, t)
  66.         call rotate(r, 'y')
  67.         call rotate(r, 'z')
  68.         call rotate(r, 'x')
  69.         call color(WHITE)
  70.  
  71.         call drawcu(nplane)
  72.  
  73.         if (nplane .eq. 1 .and. ifill) then
  74.             call polymo(PYM_LI)
  75.             call color(BLACK)
  76.             call drawcu(nplane)
  77.         if (ifill) call polymo(PYM_FI)
  78.         endif
  79.  
  80.         call popmat
  81.  
  82.         t = t + dt
  83.         if (t .gt. 3.0 .or. t .lt. -18.0) dt = -dt
  84.  
  85.         call swapbu
  86.  
  87.         s = qtest()
  88.         if (s) then
  89.             call gexit
  90.             stop
  91.         endif
  92.  
  93.         r = r + dr
  94.  
  95.     goto 10
  96.  
  97.     end
  98.  
  99. c
  100. c this routine draws the cube, using colours if available
  101. c
  102.     subroutine drawcu(nplane)
  103.     integer nplane
  104.  
  105. #include "fvogl.h"
  106.  
  107.     real carray(3, 8)
  108.     data carray/
  109.      +     -1.0,  -1.0,   1.0,
  110.      +      1.0,  -1.0,   1.0,
  111.      +      1.0,   1.0,   1.0,
  112.      +     -1.0,   1.0,   1.0,
  113.      +     -1.0,  -1.0,  -1.0,
  114.      +      1.0,  -1.0,  -1.0,
  115.      +      1.0,   1.0,  -1.0,
  116.      +     -1.0,   1.0,  -1.0/
  117.  
  118.     if (nplane.gt.1) call color(RED)
  119.  
  120.     call pmv(carray(1,1), carray(2,1), carray(3,1))
  121.     call pdr(carray(1,2), carray(2,2), carray(3,2))
  122.     call pdr(carray(1,3), carray(2,3), carray(3,3))
  123.     call pdr(carray(1,4), carray(2,4), carray(3,4))
  124.     call pclos
  125.     
  126.     if (nplane.gt.1) call color(GREEN)
  127.  
  128.     call pmv(carray(1,6), carray(2,6), carray(3,6))
  129.     call pdr(carray(1,5), carray(2,5), carray(3,5))
  130.     call pdr(carray(1,8), carray(2,8), carray(3,8))
  131.     call pdr(carray(1,7), carray(2,7), carray(3,7))
  132.     call pclos
  133.  
  134.     if (nplane.gt.1) call color(YELLOW)
  135.  
  136.     call pmv(carray(1,2), carray(2,2), carray(3,2))
  137.     call pdr(carray(1,6), carray(2,6), carray(3,6))
  138.     call pdr(carray(1,7), carray(2,7), carray(3,7))
  139.     call pdr(carray(1,3), carray(2,3), carray(3,3))
  140.     call pclos
  141.  
  142.     if (nplane.gt.1) call color(BLUE)
  143.  
  144.     call pmv(carray(1,1), carray(2,1), carray(3,1))
  145.     call pdr(carray(1,4), carray(2,4), carray(3,4))
  146.     call pdr(carray(1,8), carray(2,8), carray(3,8))
  147.     call pdr(carray(1,5), carray(2,5), carray(3,5))
  148.     call pclos
  149.  
  150.     if (nplane.gt.1) call color(MAGENT)
  151.  
  152.     call pmv(carray(1,3), carray(2,3), carray(3,3))
  153.     call pdr(carray(1,7), carray(2,7), carray(3,7))
  154.     call pdr(carray(1,8), carray(2,8), carray(3,8))
  155.     call pdr(carray(1,4), carray(2,4), carray(3,4))
  156.     call pclos
  157.     
  158.     if (nplane.gt.1) call color(CYAN)
  159.  
  160.     call pmv(carray(1,1), carray(2,1), carray(3,1))
  161.     call pdr(carray(1,5), carray(2,5), carray(3,5))
  162.     call pdr(carray(1,6), carray(2,6), carray(3,6))
  163.     call pdr(carray(1,2), carray(2,2), carray(3,2))
  164.     call pclos
  165.  
  166.     end
  167.